home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 4
/
Apprentice-Release4.iso
/
Utilities
/
Text
/
OzTeX 1.9
/
PS-files
/
getfonts.ps
< prev
next >
Wrap
Text File
|
1989-06-04
|
1KB
|
76 lines
%!
% This modified fontlist.ps returns sorted list of resident fonts to host.
/MaxNrOfFonts 100 def % Maximum numbers of fonts...
/num 0 def % local counter
/incr {
/num num 1 add def
} def
/s40 { 40 string } def % Proper length of the fontname
/newline { % Send carriage return
(\r) print flush
} def
/CountFonts { % Count the fonts and put the names into array
FontDirectory
{
pop
s40
cvs
incr
}
forall
/FontArray num array def
FontArray astore
pop
} def
/ListFonts { % Sort the fonts and send them to host
Bubbelsort
FontArray
{ print newline
}
forall
} def
/Bubbelsort { % Here is the sorting routine
1 1 num 1 sub
{
/localcount exch def
num 1 sub -1 localcount
{
/innercount exch def
/firststring FontArray innercount 1 sub get def
/secondstring FontArray innercount get def
firststring secondstring gt
{
FontArray innercount 1 sub secondstring put
FontArray innercount firststring put
} if
} for
} for
} def
/Times-Roman findfont 12 scalefont setfont
CountFonts
(Number of fonts: ) print
num s40 cvs print newline
newline
ListFonts
newline
/Times-Bold findfont 12 scalefont setfont
(Total memory: ) print
vmstatus s40 cvs print newline
(Memory used: ) print
s40 cvs print newline
pop
(Free memory: ) print
vmstatus exch sub s40 cvs print newline
pop